home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / prodpack.zip / DB4PPSRC.EXE / SCR2PRG.PRG < prev    next >
Text File  |  1993-05-11  |  16KB  |  615 lines
  1. *' $Header: $
  2. PROCEDURE Scr2Prg
  3. PARAMETERS pcPara1, pcPara2, pcPara3, pcPara4
  4. *----------------------------------------------------------------------------
  5. * NAME
  6. *   Scr2Prg - 
  7. *
  8. * DESCRIPTION
  9. *
  10. * PARAMETERS
  11. *   pcScr      = Name of SCR file used to make a dialog box
  12. *
  13. *----------------------------------------------------------------------------
  14.   SET SAFETY OFF
  15.   SET TALK OFF
  16.   SET STATUS OFF
  17.   SET CURSOR OFF
  18.   SET CLOCK ON
  19.   SET FULLPATH ON
  20.   SET EXACT ON
  21.   SET PATH TO \test\ccppdbb\dbos, \test\ccppdbb\prgs, \test\ccppprgs\dbos, \test\ccppprgs\prgs 
  22.  
  23.   IF LEFT( OS(), 3 ) = "DOS"
  24.     lc_slash = "\"
  25.   ELSE
  26.     lc_slash = "/"
  27.   ENDIF
  28.  
  29.   cDboDir = ""
  30.   cPrgDir = ""
  31.   cScrDir = ""
  32.   cScr2Gen = ""
  33.   cCurDir = SET( "DIRECTORY" )
  34.   DO CASE
  35.     CASE RIGHT( cCurDir,7 ) = "CCPPDBB"
  36.       PUBLIC DBW_HELP
  37.       DBW_HELP = "DBBHELP"
  38.     CASE RIGHT( cCurDir,8 ) = "CCPPMFFU"
  39.       PUBLIC DBW_HELP
  40.       DBW_HELP = "MFFUHELP"
  41.   ENDCASE
  42.  
  43.   *-- Scan arguments
  44.   nArgs = PCOUNT()
  45.   n = 1
  46.   DO WHILE n <= nArgs .AND. n <= 4
  47.     cnVar = STR( n, 1 )
  48.     cArg = UPPER( pcPara&cnVar. )
  49.     DO CASE
  50.       CASE LEFT( cArg, 2 ) = "-D"       && DBO Directory
  51.         nComma = AT( ",", cArg )
  52.         IF nComma > 0
  53.           cDboDir = LTRIM( TRIM( SUBSTR( cArg, nComma + 1 ) ) )
  54.         ELSE
  55.           cDboDir = LTRIM( TRIM( SUBSTR( cArg, 3 ) ) )
  56.         ENDIF
  57.  
  58.         IF RIGHT( cDboDir, 1 ) <> lc_Slash
  59.           cDboDir = cDboDir + lc_Slash
  60.         ENDIF
  61.  
  62.       CASE LEFT( cArg, 2 ) = "-P"       && PRG Directory
  63.         nComma = AT( ",", cArg )
  64.         IF nComma > 0
  65.           cPrgDir = LTRIM( TRIM( SUBSTR( cArg, nComma + 1 ) ) )
  66.         ELSE
  67.           cPrgDir = LTRIM( TRIM( SUBSTR( cArg, 3 ) ) )
  68.         ENDIF
  69.  
  70.         IF RIGHT( cPrgDir, 1 ) <> lc_Slash
  71.           cPrgDir = cPrgDir + lc_Slash
  72.         ENDIF
  73.  
  74.       CASE LEFT( cArg, 2 ) = "-S"       && PRG Directory
  75.         nComma = AT( ",", cArg )
  76.         IF nComma > 0
  77.           cScrDir = LTRIM( TRIM( SUBSTR( cArg, nComma + 1 ) ) )
  78.         ELSE
  79.           cScrDir = LTRIM( TRIM( SUBSTR( cArg, 3 ) ) )
  80.         ENDIF
  81.  
  82.         IF RIGHT( cScrDir, 1 ) <> lc_Slash
  83.           cScrDir = cScrDir + lc_Slash
  84.         ENDIF
  85.  
  86.       OTHERWISE                         && File list of PRGs
  87.         cScr2Gen = LTRIM( TRIM( cArg ) )
  88.     ENDCASE
  89.     n = n + 1
  90.   ENDDO
  91.  
  92.   *-------------------------
  93.   *-- Validate DBO Directory
  94.   *-------------------------
  95.   IF .NOT. ISBLANK( cDboDir )
  96.     fhCheckIt = 0
  97.     fhCheckIt = FCREATE( cDboDir + "CHECHIT.OUT" )
  98.     IF fhCheckIt > 0
  99.       IF FCLOSE( fhCheckIt )
  100.         cFullPath = LEFT( cDboDir, LEN( cDboDir ) - 1 )
  101.         SET DIRECTORY TO &cFullPath
  102.         ERASE CHECHIT.OUT
  103.         cDboDir = SET( "DIRECTORY" )
  104.         SET DIRECTORY TO &cCurDir
  105.       ENDIF
  106.     ELSE
  107.       cMsg = [DBO Directory does not exist:] + cDboDir
  108.       ? cMsg
  109.       ! ECHO &cMsg.
  110.       QUIT WITH 1
  111.     ENDIF
  112.   ELSE
  113.     cDboDir = SET( "DIRECTORY" )
  114.   ENDIF
  115.  
  116.   *-------------------------
  117.   *-- Validate PRG Directory
  118.   *-------------------------
  119.   IF .NOT. ISBLANK( cPrgDir )
  120.     fhCheckIt = 0
  121.     fhCheckIt = FCREATE( cPrgDir + "CHECHIT.OUT" )
  122.     IF fhCheckIt > 0
  123.       IF FCLOSE( fhCheckIt )
  124.         cFullPath = LEFT( cPrgDir, LEN( cPrgDir ) - 1 )
  125.         SET DIRECTORY TO &cFullPath
  126.         ERASE CHECHIT.OUT
  127.         cPrgDir = SET( "DIRECTORY" )
  128.         SET DIRECTORY TO &cCurDir
  129.       ENDIF
  130.     ELSE
  131.       cMsg = [PRG Directory does not exist:] + cPrgDir
  132.       ? cMsg
  133.       ! ECHO &cMsg.
  134.       QUIT WITH 1
  135.     ENDIF
  136.   ELSE
  137.     cPrgDir = SET( "DIRECTORY" )
  138.   ENDIF
  139.  
  140.   *-------------------------
  141.   *-- Validate SCR Directory
  142.   *-------------------------
  143.   IF .NOT. ISBLANK( cScrDir )
  144.     fhCheckIt = 0
  145.     fhCheckIt = FCREATE( cScrDir + "CHECHIT.OUT" )
  146.     IF fhCheckIt > 0
  147.       IF FCLOSE( fhCheckIt )
  148.         cFullPath = LEFT( cScrDir, LEN( cScrDir ) - 1 )
  149.         SET DIRECTORY TO &cFullPath
  150.         ERASE CHECHIT.OUT
  151.         cScrDir = SET( "DIRECTORY" )
  152.         SET DIRECTORY TO &cCurDir
  153.       ENDIF
  154.     ELSE
  155.       cMsg = [PRG Directory does not exist:] + cScrDir
  156.       ? cMsg
  157.       ! ECHO &cMsg.
  158.       QUIT WITH 1
  159.     ENDIF
  160.   ELSE
  161.     cScrDir = SET( "DIRECTORY" )
  162.   ENDIF
  163.  
  164.   *-----------------------------------
  165.   *-- Make sure SCR to generate exists
  166.   *-----------------------------------
  167.   IF ISBLANK( cScr2Gen )
  168.     cMsg = [No SCR file to generate. Quitting with no error.]
  169.     ? cMsg
  170.     ! ECHO &cMsg.
  171.     QUIT WITH 0
  172.   ENDIF
  173.   IF .NOT. ( ":" $ cScr2Gen .OR. lc_Slash $ cScr2Gen )
  174.     cScr2Gen = cScrDir + lc_Slash + cScr2Gen
  175.   ENDIF
  176.   cFullPre = cScr2Gen
  177.   IF .NOT. ( "." $ cScr2Gen )
  178.     cScr2Gen = cScr2Gen + ".scr"
  179.   ELSE
  180.     DO _FullPre WITH cFullPre
  181.   ENDIF
  182.  
  183.     gn_OdMax  = 4
  184.     gn_OdCur  = 0
  185.     gn_OdLeft = 0
  186.     gn_OdRight = 0
  187.     gc_OdText = [Creating file for generation: ] + cFullPre
  188.     gc_OdBoxCl = ""
  189.     DO _Odomet
  190.  
  191.   SET DIRECTORY TO &cScrDir
  192.  
  193.   cScrRoot = _FileRoot( cScr2Gen) 
  194.   DEXPORT SCREEN ( cScrRoot)
  195.     gn_OdCur  = gn_OdCur + 1
  196.     DO _Odomet
  197.  
  198.   pnGenCode = DGEN( "SCR2DBF.GEN", cScrRoot + ".SNL" )
  199.   ERASE cScrRoot + ".SNL"
  200.   ERASE scr2dbf.dbo
  201.   ERASE cDboDir + lc_Slash + cScrRoot + ".dbo"
  202.   ERASE cDboDir + lc_Slash + cScrRoot + ".win"
  203.  
  204.   COMPILE Scr2Dbf
  205.  
  206.     gn_OdCur  = gn_OdCur + 1
  207.     DO _Odomet   
  208.  
  209.   DO Scr2Dbf  WITH _TmpName( ".DBF" )
  210.   cDbf = DBF()
  211.   USE ( cDbf ) ALIAS &cScrRoot. NOSAVE
  212.  
  213.     gn_OdCur  = gn_OdCur + 1
  214.     DO _Odomet
  215.  
  216.   ERASE scr2dbf.prg
  217.   ERASE scr2dbf.dbo
  218.  
  219.   DO MakeItEz WITH cScrRoot
  220.  
  221.     gn_OdCur  = gn_OdCur + 1
  222.     DO _Odomet
  223.  
  224.   DO GroupObj
  225.  
  226.     gn_OdCur  = gn_OdCur + 5
  227.     DO _Odomet
  228.  
  229.   DO GenCode WITH cScrRoot
  230.  
  231.   CLOSE DATABASE
  232.   
  233.  
  234.   lCompileOk = .T.
  235.   IF .NOT. FILE( cScrRoot + ".dbo" )
  236.     ERASE cScrRoot + ".err"
  237.     SET ALTERNATE TO cScrRoot + ".err"
  238.     SET ALTERNATE ON
  239.     SET TALK ON
  240.     SET CONSOLE ON
  241.  
  242.     ON ERROR lCompileOk = .F.
  243.     COMPILE cScrRoot + ".prg"
  244.     ON ERROR
  245.  
  246.     SET ALTERNATE OFF
  247.     SET ALTERNATE TO
  248.     SET TALK OFF
  249.     SET CONSOLE OFF
  250.   ENDIF
  251.   IF lCompileOk
  252.     ERASE cScrRoot + ".err"
  253.     *------------------------------------------
  254.     *-- Move the resulting program files around
  255.     *------------------------------------------
  256.     IF cScrDir <> cDboDir
  257.       cSource = cFullPre + ".dbo"
  258.       ! COPY &cSource. &cDboDir
  259.       ERASE ( cSource )
  260.     ENDIF
  261.     IF cScrDir <> cPrgDir
  262.       cSource = cFullPre + ".prg"
  263.       ! COPY &cSource. &cPrgDir
  264.       ERASE ( cSource )
  265.     ENDIF
  266.  
  267.     cQCode = 0
  268.   ELSE
  269.     cQCode = 1
  270.   ENDIF
  271.  
  272.   SET DIRECTORY TO &cCurDir
  273.  
  274. QUIT WITH cQCode
  275. *-- EOP: Scr2Prg WITH pcScr
  276.  
  277.  
  278. FUNCTION _TmpName    && Returns a pseudo-random file root name
  279. PARAMETER pc_ext
  280. *--------------------------------------------------------------------
  281. * NAME
  282. *   _TmpName - Returns a pseudo-random file root name.
  283. *
  284. * SYNOPSIS
  285. *   _TmpName( [.ext] )
  286. *
  287. * DESCRIPTION
  288. *   _TMPNAME() returns an pseudo-random string of
  289. *   digits suitable for use as a temporary file name.
  290. *   Eight digits (sometimes fewer) are returned.
  291. *   Successive calls to _TMPNAME() can be used to
  292. *   generate a series of unique file names.
  293. *
  294. *   An optional file extension can be passed as an
  295. *   argument.  If this is done, _TMPNAME will make
  296. *   sure that the file name it returns does not already
  297. *   exist within the current dBASE path setting.
  298. *
  299. *   If either the DBTMP or TMP DOS environment variables
  300. *   are set, _TMPNAME() will use its value for a path
  301. *   prefix.  If both are set, the DBTMP value is used.
  302. *
  303. * PARAMETERS
  304. *   pc_ext - optional file name extension.  May optionally
  305. *   start with a ".", followed by up to three characters.
  306. *   (Note that some characters are not allowed in file names,
  307. *    depending on the specific operating system in use.)
  308. *
  309. * EXAMPLE
  310. *
  311. *   lc_tmpfile = _TMPNAME(".TMP")
  312. *   * Possible return value: "87113336.TMP"
  313. *   USE master
  314. *   COPY TO (lc_tmpfile)
  315. *   * The file "87113336.TMP" would now exist
  316. *
  317. * LIMITATIONS
  318. *   If _TMPNAME() is used without the extension
  319. *   parameter, the FILE() function can be used to
  320. *   make certain that a created file name does not
  321. *   already exist.
  322. *
  323. *   _TMPNAME() assumes the extension argument has
  324. *   only characters allowed in filenames.
  325. *
  326. *   Note also that leading 0's will not be returned.
  327. *   If you desire exactly eight digits, this line:
  328. *     TRANSFORM( RAND(-1) * 100000000, "@L 99999999" )
  329. *   returns a random string of digits that is always
  330. *   eight characters long.
  331. *
  332. * SEE ALSO:
  333. *   RAND(), FILE()
  334. *
  335. *--------------------------------------------------------------------
  336.  
  337.   PRIVATE lc_env, lc_ext, lc_prefix, lc_root, lc_slash, ;
  338.           ll_err, lh_chkit
  339.  
  340.   IF LEFT( OS(), 3 ) = "DOS"
  341.     lc_slash = "\"
  342.   ELSE
  343.     lc_slash = "/"
  344.   ENDIF
  345.  
  346.   lh_chkit = 0
  347.  
  348.   lc_env = GETENV( "DBTMP" )
  349.   IF .NOT. ISBLANK( lc_env )
  350.     ll_err = .F.
  351.     ON ERROR ll_err = .T.
  352.     lc_prefix = IIF( RIGHT( lc_env, 1 ) = lc_slash, lc_env, lc_env + lc_slash )
  353.     lh_chkit = FCREATE( lc_prefix + [CHECKIT.OUT] )
  354.     IF lh_chkit > 0
  355.       IF FCLOSE( lh_chkit )
  356.         ERASE ( lc_prefix + [CHECKIT.OUT] )
  357.       ENDIF
  358.     ELSE
  359.       lc_env = ""
  360.       ll_err = .F.
  361.     ENDIF
  362.     ON ERROR
  363.   ENDIF
  364.  
  365.   IF ISBLANK( m->lc_env )
  366.     lc_env = GETENV( "TMP" )
  367.     IF .NOT. ISBLANK( lc_env )
  368.       ll_err = .F.
  369.       ON ERROR ll_err = .T.
  370.       lc_prefix = IIF( RIGHT( lc_env, 1 ) = lc_slash, lc_env, lc_env + lc_slash )
  371.       lh_chkit = FCREATE( lc_prefix + [CHECKIT.OUT] )
  372.       IF lh_chkit > 0
  373.         IF FCLOSE( lh_chkit )
  374.           ERASE ( lc_prefix + [CHECKIT.OUT] )
  375.         ENDIF
  376.       ELSE
  377.         lc_env = ""
  378.         ll_err = .F.
  379.       ENDIF
  380.       ON ERROR
  381.     ENDIF
  382.  
  383.     IF ISBLANK( m->lc_env )
  384.       lc_prefix = ""
  385.     ELSE
  386.       lc_prefix = IIF( RIGHT( lc_env, 1 ) = lc_slash, lc_env, lc_env + lc_slash )
  387.     ENDIF
  388.  
  389.   ELSE
  390.     lc_prefix = IIF( RIGHT( lc_env, 1 ) = lc_slash, lc_env, lc_env + lc_slash )
  391.   ENDIF
  392.  
  393.   IF PCOUNT() = 0
  394.     lc_root = m->lc_prefix + LTRIM( STR( RAND( -1 ) * 100000000, 8 ) )
  395.     RETURN( lc_root )
  396.   ELSE
  397.  
  398.     IF .NOT. "." $ m->pc_ext
  399.       lc_ext = "." + m->pc_ext
  400.     ELSE
  401.       lc_ext = m->pc_ext
  402.     ENDIF
  403.  
  404.     lc_ext = SUBSTR(m->lc_ext, 1, 4)
  405.  
  406.     DO WHILE .T.
  407.       lc_root = LTRIM( STR( RAND( -1 ) * 100000000, 8 ) )
  408.  
  409.       IF .NOT. FILE( m->lc_prefix + m->lc_root + m->lc_ext )
  410.         RETURN( m->lc_prefix + m->lc_root + m->lc_ext )
  411.       ENDIF
  412.  
  413.     ENDDO
  414.  
  415.   ENDIF
  416. *-- EOF: _TmpName( [.ext] )
  417.  
  418.  
  419. FUNCTION _FWrite0
  420. PARAMETERS ph_file, pn_nulls
  421. *--------------------------------------------------------------------
  422. * NAME
  423. *   _FWrite0 - Write number of CHR(0)s to open file.
  424. *
  425. * SYNOPSIS
  426. *   _FWrite0( ph_file, pn_nulls )
  427. *
  428. * DESCRIPTION
  429. *   _FWrite0 will write out to an open file handle <ph_file>,
  430. *   <pn_nulls> null characters ( 00h ).  This is useful since
  431. *   REPLICATE() currently does not support CHR(0).
  432. *
  433. * PARAMETERS
  434. *   ph_file  - numeric file handle of the target file.
  435. *   pn_nulls - number of CHR(0)s to output.
  436. *
  437. * EXAMPLE
  438. *   * Write 100 nulls to the start of "MYFILE.TXT":
  439. *   lh_file = FOPEN( "MYFILE.TXT", "rw" )
  440. *   ln_var  = FWrite0( lh_file, 100 )
  441. *   ln_mem  = FCLOSE( "MYFILE.TXT" )
  442. *
  443. * SEE ALSO
  444. *   FOPEN(), FWRITE()
  445. *--------------------------------------------------------------------
  446.  
  447.   PRIVATE ln_count, ln_chrs
  448.  
  449.   ln_count = 1
  450.  
  451.   DO WHILE m->ln_count <= m->pn_nulls
  452.     ln_chrs = FWRITE( m->ph_file, CHR(0) )
  453.     ln_count = m->ln_count + 1
  454.   ENDDO
  455.  
  456. RETURN( m->pn_nulls )
  457. *-- EOF: _FWrite0( ph_file, pn_nulls )
  458.  
  459.  
  460. FUNCTION _MakeExte
  461. PARAMETER pc_fname
  462. *--------------------------------------------------------------------
  463. * NAME
  464. *   _MAKEEXTE - Creates a dBASE IV structure extended
  465. *               file.
  466. *
  467. * SYNOPSIS
  468. *   _MAKEEXTE( pc_fname )
  469. *
  470. * DESCRIPTION
  471. *   The _MAKEEXTE() function creates an empty dBASE IV
  472. *   structure extended file.  It uses low-level file
  473. *   I/O functions to write the structure directly to
  474. *   disk.  This file can then be used to create
  475. *   other database files.
  476. *
  477. *   _MAKEEXTE() will return .T. if the filename was
  478. *   created, otherwise .F.  If no file extension is
  479. *   specified, ".DBF" is assumed.
  480. *
  481. *   Be warned that if a file with the same name
  482. *   already exists, it will be automatically
  483. *   overwritten.
  484. *
  485. * PARAMETER
  486. *   pc_fname - the name of the new structure extended
  487. *              file to create.
  488. *
  489. * EXAMPLE
  490. *
  491. *   * Create a new .DBF with a single field:
  492. *   IF _MAKEEXTE( "custtemp" )
  493. *     USE custtemp
  494. *     APPEND BLANK
  495. *     REPLACE field_name WITH "LAST_NAME",;
  496. *             field_type WITH "C",;
  497. *             field_len  WITH 30,;
  498. *             field_idx  WITH "Y"
  499. *     CREATE newdbf FROM custtemp
  500. *   ELSE
  501. *     ? "Error: Custtemp.dbf not created"
  502. *   ENDIF
  503. *
  504. * DEPENDENCIES
  505. *   _MAKEEXTE() uses the _FWRITE0 function.
  506. *
  507. * LIMITATIONS
  508. *   _MAKEEXTE() expects that TALK is OFF
  509. *
  510. * SEE ALSO:
  511. *   COPY STRUCTURE EXTENDED
  512. *
  513. *--------------------------------------------------------------------
  514.  
  515.   PRIVATE lc_newdbf, lh_newdbf, ll_result, ln_bytes
  516.  
  517.   ll_result = .F.
  518.   lc_newdbf = LTRIM( RTRIM( pc_fname ) )
  519.  
  520.   IF TYPE('lc_newdbf') = "C" .AND. ( .NOT. ISBLANK( lc_newdbf ) )
  521.  
  522.     lc_newdbf = IIF( .NOT. "." $ lc_newdbf, lc_newdbf, ;
  523.                      SUBSTR(lc_newdbf, 1, AT(".", lc_newdbf) - 1)) + ".DBF"
  524.     lh_newdbf = 0
  525.     IF DISKSPACE() < 5000
  526.       DEACTIVATE WINDOW _plswait        && Deactivate _PlsWait window
  527.       DO _Err_Box WITH [Insufficient disk space]
  528.       IF LASTKEY() = 28
  529.         DO _Helpsys WITH "_FXZERR", "NODISK"
  530.       ENDIF
  531.     ELSE
  532.       lh_newdbf = FCREATE( lc_newdbf, "rw" )
  533.     ENDIF
  534.     IF lh_newdbf > 0
  535.  
  536.       *-- .dbf with no memos
  537.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  538.  
  539.       *-- date of last update
  540.       ln_bytes = FWRITE( lh_newdbf, ;
  541.         CHR( YEAR( DATE() ) - 1900 ) + CHR( MONTH( DATE() ) )+;
  542.         CHR( DAY( DATE() ) ) )
  543.  
  544.       *-- No records yet
  545.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  546.  
  547.       *-- Number of bytes in header.
  548.       ln_bytes = FWRITE( lh_newdbf, CHR(193) )
  549.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  550.  
  551.       *-- Number off bytes in each records
  552.       ln_bytes = FWRITE( lh_newdbf, CHR(19) )
  553.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  554.  
  555.       *-- Fill other dbf header stuff
  556.       ln_bytes = _FWRITE0( lh_newdbf, 20 )
  557.  
  558.       *-- Write out the extended structure.
  559.       ln_bytes = FWRITE( lh_newdbf, "FIELD_NAME" )
  560.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  561.       ln_bytes = FWRITE( lh_newdbf, "C" )
  562.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  563.       ln_bytes = FWRITE( lh_newdbf, CHR(10) )
  564.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  565.  
  566.       ln_bytes = FWRITE( lh_newdbf, "FIELD_TYPE" )
  567.       ln_bytes = FWRITE( lh_newdbf, CHR(0) )
  568.       ln_bytes = FWRITE( lh_newdbf, "C" )
  569.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  570.       ln_bytes = FWRITE( lh_newdbf, CHR(1) )
  571.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  572.  
  573.       ln_bytes = FWRITE( lh_newdbf, "FIELD_LEN" )
  574.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  575.       ln_bytes = FWRITE( lh_newdbf, "N" )
  576.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  577.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  578.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  579.  
  580.       ln_bytes = FWRITE( lh_newdbf, "FIELD_DEC" )
  581.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  582.       ln_bytes = FWRITE( lh_newdbf, "N" )
  583.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  584.       ln_bytes = FWRITE( lh_newdbf, CHR(3) )
  585.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  586.  
  587.       ln_bytes = FWRITE( lh_newdbf, "FIELD_IDX" )
  588.       ln_bytes = _FWRITE0( lh_newdbf, 2 )
  589.       ln_bytes = FWRITE( lh_newdbf, "C" )
  590.       ln_bytes = _FWRITE0( lh_newdbf, 4 )
  591.       ln_bytes = FWRITE( lh_newdbf, CHR(1) )
  592.       ln_bytes = _FWRITE0( lh_newdbf, 15 )
  593.  
  594.       *-- Write the field (header) terminator
  595.       ln_bytes = FWRITE( lh_newdbf, CHR(13) )
  596.  
  597.       IF FCLOSE( lh_newdbf )
  598.         ll_result = .T.
  599.       ENDIF
  600.  
  601.     ENDIF   && Could not create DBF skeleton
  602.  
  603.   ENDIF   && Parameters not correct
  604.  
  605. RETURN( ll_result )
  606. *-- EOF: _MakeExte( pc_fname )
  607.  
  608.  
  609. *'----------------------------------------------------------------------------
  610. *' $Log: $
  611. *'----------------------------------------------------------------------------
  612.  
  613.  
  614.  
  615.